VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Service"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "Provides an interface for AEWorker.Worker objects to call, to execute realistic examples of server side processing."
Option Explicit

Implements APEInterfaces.Service

Private mwsService As Workspace
Private mdbService As Database
Private mbDBCreated As Boolean

Public Sub Execute(ByRef sCommand As String, Optional ByRef vServiceData As Variant, Optional ByRef vReturn As Variant)
Attribute Execute.VB_Description = "AEWorker.Worker objects call this method when using late binding."
    '-------------------------------------------------------------------------
    'Purpose:
    '   Provides an interface for late binding.  Late binding is only provide
    '   for test comparison.  Other custom services should only use the implemented
    '   interface.
    '-------------------------------------------------------------------------
    Dim bSecondMissing As Boolean
    Dim bThirdMissing As Boolean
    bSecondMissing = IsMissing(vServiceData)
    bThirdMissing = IsMissing(vReturn)
    If bSecondMissing And bThirdMissing Then
        Service_Execute sCommand
    ElseIf bThirdMissing Then
        Service_Execute sCommand, vServiceData
    ElseIf bSecondMissing Then
        Service_Execute sCommand, , vReturn
    Else
        Service_Execute sCommand, vServiceData, vReturn
    End If
End Sub

Private Sub Service_Execute(sCommand As String, Optional vServiceData As Variant, Optional vReturn As Variant)
    '-------------------------------------------------------------------------
    'Purpose:
    '   In response to the data it receives, it may return data of different
    '   sizes are types and/or sleep or burn processor cycles for a certain
    '   amount of time.
    'In:
    '   [sCommand]
    '       A string the represents what this procedure should do.  It is intended
    '       be used to case and call an appropriate procedure in response if this
    '       was a real solution service provider.  This object expects either
    '       "UseProcessor" or "DontUserProcessor".
    '   [vServiceData]
    '       This object expects a variant array or variant collection in which
    '       the elements of the array or collection specify how much data to
    '       return, what type of data to return, and how long to wait before
    '       releasing the calling worker.
    'Out:
    '   [vReturn]
    '       This could be a variant array or collection of any specified size
    '       it will be returned by the calling worker to the client or the
    '       expediter
    '-------------------------------------------------------------------------
    'sCommand   What to do.  Ex: "Method"
    'vServiceData      The data needed to carrry out sCommand.
    Dim iLensCommand As Integer
    Dim iChar As Integer
    Dim iLastChar As Integer
    Dim lEndTicks As Long
    Dim lRecordNumRows As Long
    Dim lRecordRowSize As Long
    Dim lRecordMilliseconds As Long
    Dim lRecordContainerType As Long
    Dim rsService As Recordset
    
    Dim s As String
    Dim i As Integer
    Dim v() As Variant
    
    On Error GoTo Service_ExecuteError
    If Not IsMissing(vServiceData) Then
        'Are we using a Varriant Array or Collection?
        If VarType(vServiceData) = (vbArray + vbVariant) Then
            'It's an array
            lRecordNumRows = vServiceData(giRECORD_NUMROWS)
            lRecordRowSize = vServiceData(giRECORD_ROWSIZE)
            lRecordMilliseconds = vServiceData(giRECORD_MILLISECONDS)
            lRecordContainerType = vServiceData(giRECORD_CONTAINER_TYPE)
        Else
            'It's a collection
            lRecordNumRows = vServiceData.Item(CStr(giRECORD_NUMROWS))
            lRecordRowSize = vServiceData.Item(CStr(giRECORD_ROWSIZE))
            lRecordMilliseconds = vServiceData.Item(CStr(giRECORD_MILLISECONDS))
            lRecordContainerType = vServiceData.Item(CStr(giRECORD_CONTAINER_TYPE))
        End If
        'Do we need to do anything?
        If lRecordMilliseconds < 0 Or lRecordMilliseconds > glMAX_DURATION Then Err.Raise giBAD_DURATION
    End If
    
    Select Case sCommand
        Case gsSERVICE_USE_PROCESSOR
            If lRecordMilliseconds > 0 Then
                lEndTicks = GetTickCount() + lRecordMilliseconds
                Do While lEndTicks > GetTickCount()
                    'Using Cycles
                Loop
            End If
        Case gsSERVICE_DONT_USE_PROCESSOR
            If lRecordMilliseconds > 0 Then
                Sleep lRecordMilliseconds
            End If
        Case gsSERVICE_READ_DATA
            If Not mbDBCreated Then CreateDBObject
            Set rsService = mdbService.OpenRecordset(gsREAD_QUERY, dbOpenDynaset)
            rsService.FindFirst gsFIND_CRITERIA
            s = rsService.Fields(gsFIELD_TO_READ).Value
            Set rsService = Nothing
        Case gsSERVICE_WRITE_DATA
            If Not mbDBCreated Then CreateDBObject
            mdbService.Execute gsWRITE_QUERY
        Case gsSERVICE_READWRITE_DATA
            If Not mbDBCreated Then CreateDBObject
            mdbService.Execute gsWRITE_QUERY
            
            Set rsService = mdbService.OpenRecordset(gsREAD_QUERY, dbOpenDynaset)
            rsService.FindFirst gsFIND_CRITERIA
            s = rsService.Fields(gsFIELD_TO_READ).Value
            Set rsService = Nothing
    End Select
    
    If (Not IsMissing(vReturn)) And lRecordContainerType <> giCONTAINER_TYPE_NULL And lRecordNumRows <> 0 And lRecordRowSize <> 0 Then
        'Return something
        Select Case lRecordContainerType
            Case giCONTAINER_TYPE_VARRAY
                s = Space(lRecordRowSize)
                ReDim v(lRecordNumRows - 1) As Variant
                For i = 0 To lRecordNumRows - 1
                    v(i) = s
                Next i
                vReturn = v
            Case giCONTAINER_TYPE_VCOLLECTION
                Set vReturn = New Collection
                s = Space(lRecordRowSize)
                For i = 1 To lRecordNumRows
                    vReturn.Add s
                Next i
            Case giCONTAINER_TYPE_RECORDSET
                'Not yet implemented
                 Set vReturn = Nothing
            Case Else
                'Some unknown ContainterTypeValue
                Err.Raise giBAD_DATA_TYPE
         End Select
    End If
    
    Exit Sub
Service_ExecuteError:
    Select Case Err.Number
        Case ERR_TYPE_MISMATCH, ERR_OVER_FLOW
            'vServiceData contained a bad data type.  Raise an appliction defined error.
            Err.Raise giBAD_DATA, Err.Source, LoadResString(giBAD_DATA)
        Case giBAD_DURATION
            'They wanted to sleep more than glMAX_DURATION
            Err.Raise Err.Number, Err.Source, ReplaceString(LoadResString(giBAD_DURATION), gsNUMBER_TOKEN, CStr(glMAX_DURATION))
        Case Is > giERROR_THRESHOLD
            'Application defined error.  Since this is the only public method
            'all errors raised there will be returned to the calling program.
            Err.Raise Err.Number + vbObjectError, Err.Source, Err.Description
        Case Else
            'VB error
            Err.Raise Err.Number, Err.Source, Err.Description
    End Select

End Sub

Private Sub Class_Initialize()
    On Error Resume Next
    CreateDBObject
End Sub

Private Sub CreateDBObject()
    Dim sPath As String
    sPath = FormatPath(App.Path) & gsDBName
    'Make sure DB file is not readonly
    SetAttr sPath, vbNormal
    SetAttr sPath, vbArchive
    Set mwsService = DBEngine.Workspaces(0) 'Default Workspace
    Set mdbService = OpenDatabase(sPath)
    mbDBCreated = True
End Sub

Private Function FormatPath(sPath As String) As String
    '-------------------------------------------------------------------------
    'Purpose:   Make sure that the passed path has a "\" at the end of it
    'IN:
    '   [sPath] File name to check
    'Return:    File name with a "\" at the end of it
    '-------------------------------------------------------------------------
    If Not Right$(sPath, 1) = "\" Then sPath = sPath & "\"
    FormatPath = sPath
        
End Function

